home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / prog / grr100.arj / GRR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-19  |  4KB  |  172 lines
  1. program getGIFheader ;
  2. uses dos ;
  3. const
  4.  progdata = 'GRR- Free DOS utility: GIF file info displayer.';
  5.  progdat2 = 'V1.00: August 19, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  6.  usage = 'Usage:  GRR directory and/or file_spec[.GIF]   Example:  GRR cindyc*';
  7. var
  8.    header  : string [6] ;
  9.  
  10.    gpixn   : byte ;
  11.  
  12.    gpixels , gback,
  13.    rwidthLSB,
  14.    rheightLSB,
  15.    rwidth,
  16.    rheight : char ;
  17.  
  18.    gifname : string [12] ;
  19.    giffile : text ;
  20.  
  21.    dirinfo : searchrec ;
  22.    gpath   : pathstr ;
  23.    gdir    : dirstr ;
  24.    gname   : namestr ;
  25.    gext    : extstr ;
  26.  
  27. procedure showhelp;
  28. begin
  29.      writeln (progdata);
  30.      writeln (progdat2);
  31.      writeln (usage);
  32.      halt ;
  33. end;
  34.  
  35. function taffy ( astring : string; newlen : byte) : string;
  36. begin
  37.     while ( length ( astring ) < newlen ) do
  38.             astring := astring + ' ' ;
  39.     taffy := astring;
  40. end;
  41.  
  42. FUNCTION LeadingZero(w : Word) : String;
  43. VAR
  44.   s : String;
  45. BEGIN
  46.   Str(w:0,s);
  47.   IF Length(s) = 1 THEN
  48.     s := '0' + s;
  49.   LeadingZero := s;
  50. END;
  51.  
  52. procedure writeftime ( fdatetime : longint );
  53. var
  54.    Year2           : String ;
  55.    DateTimeInf     : DateTime ;
  56. begin
  57.    UnpackTime( fdatetime,DateTimeInf);
  58.    WITH DateTimeInf DO
  59.    BEGIN
  60.         Year2 := LeadingZero(Year);
  61.         Delete(Year2,1,2);
  62.         Write  (
  63.                 LeadingZero(Month)     ,'-',
  64.                 LeadingZero(Day)       ,'-',
  65.                 Year2                  ,'  ',
  66.                 LeadingZero(Hour)      ,':',
  67.                 LeadingZero(Min)       ,':',
  68.                 LeadingZero(Sec)
  69.                );
  70.    END;
  71. end;
  72.  
  73. procedure displaygifscreenstats ( screendes : byte );
  74. var
  75.    GCM : Boolean ;
  76.  
  77. begin
  78.      GCM := screendes > 128;
  79.      if screendes > 128 then
  80.         screendes := screendes - 128;
  81.      if screendes > 64 then
  82.         screendes := screendes - 64;
  83.      if screendes > 32 then
  84.         screendes := screendes - 32;
  85.      if screendes > 16 then
  86.         screendes := screendes - 16;
  87.      if screendes > 8 then
  88.         screendes := screendes - 8;
  89.      case screendes of
  90.        0 : write ( '  2' );
  91.        1 : write ( '  4' );
  92.        2 : write ( '  8' );
  93.        3 : write ( ' 16' );
  94.        4 : write ( ' 32' );
  95.        5 : write ( ' 64' );
  96.        6 : write ( '128' );
  97.        7 : write ( '256' );
  98.      end;
  99.      If GCM Then
  100.         Write (' ]  GCM/')
  101.      Else
  102.         Write (' ]  ---/');
  103.  
  104. end;
  105.  
  106. procedure checkforgiflite ( VAR thefile : text );
  107. var
  108.    ic            : word ;
  109.    dummy, glite  : char ;
  110.    gliteword     : string [7] ;
  111.  
  112. begin
  113.           for ic := 13 to 784 do
  114.               read ( thefile, dummy );
  115.  
  116.           gliteword := '       ' ;
  117.           for ic := 1 to 7 do begin
  118.               read ( thefile, glite );
  119.               gliteword[ic] := glite ;
  120.           end ;
  121.  
  122.           if ( pos ( 'GIFLITE', gliteword ) = 1 ) then
  123.              write ( 'GL' )
  124.           else
  125.              write ( '--' );
  126. end;
  127.  
  128. begin
  129.      gpath := '' ;
  130.      gpath := paramstr ( 1 );
  131.      if ( gpath = '' ) then
  132.         gpath := '*.gif' ;
  133.  
  134.      if ( pos ( '.',gpath ) <> 0 ) then begin
  135.         gpath := copy ( gpath,1,pos ( '.',gpath ));
  136.         gpath := gpath + 'gif'
  137.      end
  138.      else gpath := gpath + '*.gif' ;
  139.  
  140.      fsplit ( fexpand ( gpath ) ,gdir,gname,gext );
  141.      findfirst ( gpath, archive, dirinfo );
  142.      if doserror <> 0 then showhelp;
  143.      while doserror = 0 do
  144.      begin
  145.           gifname := dirinfo.name;
  146.           assign ( giffile, gdir + gifname );
  147.           reset ( giffile );
  148.           read ( giffile,header );
  149.           if ( pos ( 'GIF' , header ) <> 1 )
  150.              then header := '?_GIF?' ;
  151.  read ( giffile, rwidthLSB , rwidth , rheightLSB , rheight , gpixels , gback );
  152.  
  153.           gifname := taffy(gifname,12);
  154.           write ( gifname , '  ', dirinfo.size:7 ,'  ');
  155.           writeftime ( dirinfo.time );
  156.           write ( '    ',header,'   [' );
  157.  
  158.           write (( ord ( rwidthLSB  ) + ( 256 * ord ( rwidth  ))) :4, ' ' ,
  159.                  ( ord ( rheightLSB ) + ( 256 * ord ( rheight ))) :4, '  ' );
  160.  
  161.           gpixn := ord ( gpixels );
  162.           displaygifscreenstats ( gpixn );
  163.  
  164. {         write ( ', ', ord ( gback )); } { This is the background color,}
  165.           checkforgiflite ( giffile );  { commented out since it is not used }
  166.  
  167.           writeln ;
  168.           close ( giffile );
  169.           findnext ( dirinfo );
  170.      end ;
  171. end.
  172.